UNIT Heap;

(* The following MPW commands will build the dcmd and copy it to the
   "Debugger Prefs" file in the System folder. The dcmd's name in
		 MacsBug will be the name of the file built by the Linker.

	    Pascal Heap.p
	    Link dcmdGlue.a.o Heap.p.o {Libraries}Runtime.o {PLibraries}PasLib.o -o Heap
	    BuildDcmd Heap 100
*)

{$R-}

INTERFACE

		USES MemTypes, dcmds;
		
  { Public declaration for dcmdGlue. Must be in every dcmd. The name cannot be changed. }
		PROCEDURE CommandEntry (paramPtr: dcmdBlockPtr);


IMPLEMENTATION

PROCEDURE NumberToHex (number: LONGINT; VAR hex: Str255);
VAR digits: Str255;
    n: INTEGER;
BEGIN
  digits := '0123456789ABCDEF';
		hex    := '00000000';
		FOR n := 8 DOWNTO 1 DO
		  BEGIN
				hex[n] := digits[1 + (number MOD 16)];
				number := number DIV 16;
				END;
END;


PROCEDURE DisplayBlockInfo (blockAddress, blockLength, masterPtr: LONGINT; blockType: INTEGER; locked, purgeable, resource: BOOLEAN);
VAR value: Str255;
BEGIN
		NumberToHex (blockAddress, value);
		dcmdDrawLine (value);

		NumberToHex (blockLength, value);
		dcmdDrawString (' ');
		dcmdDrawString (value);

		IF blockType = relocatableBlock THEN
		  BEGIN
				NumberToHex (masterPtr, value);
				dcmdDrawString (' ');
				dcmdDrawString (value);

				dcmdDrawString (' ');
				IF locked THEN
						dcmdDrawString ('Locked ');
				IF purgeable THEN
						dcmdDrawString ('Purgeable ');
				IF resource THEN
						dcmdDrawString ('Resource ');
				END;
END;


PROCEDURE CommandEntry (paramPtr: DCmdBlockPtr);
BEGIN
  IF paramPtr^.request = dcmdInit THEN
		  BEGIN	{ The dcmd gets called once when loaded to init itself }
				END
		ELSE
  IF paramPtr^.request = dcmdDoIt THEN
		  BEGIN { Do the command's normal function }
				{ Draw the column labels }
				dcmdDrawLine ('  Address   Length  Mstr Ptr');

    { The MacsBug heap iterator will call DisplayBlockInfo once for each block in the heap }
				dcmdForAllHeapBlocks (@DisplayBlockInfo);
				END
		ELSE
  IF paramPtr^.request = dcmdHelp THEN
		  BEGIN { Display the command's help information }
				dcmdDrawLine ('HEAP');
				dcmdDrawLine ('   Displays information about all heap blocks');
				END;
END;

END.
